Amiga Tools 5/Amiga Tools 5.iso/tools/developer-tools/andere sprachen/oberonv4/oberon-src/system/sessions.mod

Oberon Text | 1996-03-03 | 17.4 KB | 434 lines

Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
3 Mar 96
FoldElems
Syntax10.Scn.Fnt
TCP,
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
NetSystem,
Syntax10b.Scn.Fnt
Syntax10.Scn.Fnt
        TCPConnection = POINTER TO RECORD(TCP.ConnectionDesc) channel: Channel END;
        TCPChannel = POINTER TO RECORD(ChannelDesc) connection: TCPConnection END;
        TCPTask = POINTER TO RECORD(TaskDesc) id: LONGINT END;
        TCPListener = POINTER TO RECORD(ListenerDesc) l: TCP.Listener END;
Syntax10.Scn.Fnt
        NSConnection = POINTER TO RECORD(NetSystem.StreamDesc) channel: Channel END;
        NSChannel = POINTER TO RECORD(ChannelDesc) connection: NSConnection END;
        NSTask = POINTER TO RECORD(TaskDesc) c: NSConnection END;
        NSListener = POINTER TO RECORD(ListenerDesc) l: NetSystem.Connection END;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
    PROCEDURE TCPGetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
        VAR connection: TCP.Connection;
    BEGIN connection := c(TCPChannel).connection;
        available := TCP.Available(connection); terminated := (available = 0) & ~TCP.Connected(connection)
    END TCPGetState;
    PROCEDURE TCPReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
    BEGIN TCP.ReadBytes(c(TCPChannel).connection, bytes, 0, n)
    END TCPReadBytes;
    PROCEDURE TCPSendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
        VAR connection: TCP.Connection;
    BEGIN connection := c(TCPChannel).connection;
        IF TCP.Connected(connection) THEN TCP.WriteBytes(connection, bytes, 0, n) END
    END TCPSendBytes;
    PROCEDURE TCPSendBreak(c: Channel);
    END TCPSendBreak;
    PROCEDURE TCPClose(c: Channel);
        VAR connection: TCP.Connection;
    BEGIN connection := c(TCPChannel).connection;
        IF TCP.Connected(connection) THEN TCP.Disconnect(connection) END
    END TCPClose;
    PROCEDURE TCPSelfChannel(t: Task): Channel;
        VAR channel: Channel; c: TCP.Connection;
    BEGIN c := TCP.ThisConnection(t(TCPTask).id);
        IF c # NIL THEN channel := c(TCPConnection).channel ELSE channel := NIL END;
        RETURN channel
    END TCPSelfChannel;
    PROCEDURE TCPSetupChannel(connection: TCPConnection; VAR channel: Channel; VAR task: Task);
        VAR c: TCPChannel; t: TCPTask;
    BEGIN NEW(c); c.connection := connection; connection.channel := c;
        c.getState := TCPGetState; c.readBytes := TCPReadBytes;
        c.sendBytes := TCPSendBytes; c.sendBreak := TCPSendBreak; c.close := TCPClose;
        NEW(t); t.id := connection.id; t.channel := TCPSelfChannel;
        channel := c; task := t
    END TCPSetupChannel;
    PROCEDURE TCPNewSession(hostname: ARRAY OF CHAR; port: LONGINT): Session;
        VAR res: INTEGER; c: TCPConnection; channel: Channel; t: Task; s: Session; adr: TCP.IpAdr;
    BEGIN s := NIL; TCP.HostByName(hostname, adr, res);
        IF res = TCP.Done THEN NEW(c); TCP.Connect(c, TCP.AnyPort, adr, SHORT(port), 0, res);
            IF res = TCP.Done THEN TCPSetupChannel(c, channel, t); s := NewSession(channel, t, hostname) END
        END;
        RETURN s
    END TCPNewSession;
    PROCEDURE TCPRequested(l: Listener): BOOLEAN;
    BEGIN RETURN TCP.Requested(l(TCPListener).l)
    END TCPRequested;
    PROCEDURE TCPAcceptedSession(l: Listener; VAR serverName: ARRAY OF CHAR): Session;
        VAR res: INTEGER; c: TCPConnection; channel: Channel; t: Task; s: Session;
    BEGIN s := NIL;
        NEW(c); TCP.Accept(l(TCPListener).l, c, res);
        IF res = TCP.Done THEN TCPSetupChannel(c, channel, t); s := NewSession(channel, t, serverName) END;
        RETURN s
    END TCPAcceptedSession;
    PROCEDURE TCPRemove(l: Listener);
    BEGIN TCP.Close(l(TCPListener).l)
    END TCPRemove;
    PROCEDURE TCPNewListener(port: LONGINT): TCPListener;
        VAR res: INTEGER; listener: TCPListener; l: TCP.Listener;
    BEGIN listener := NIL;
        NEW(l); TCP.Listen(l, SHORT(port), TCP.AnyAdr, TCP.AnyPort, res);
        IF res = TCP.Done THEN NEW(listener); listener.l := l;
            listener.requested := TCPRequested; listener.acceptedSession := TCPAcceptedSession;
            listener.remove := TCPRemove
        END;
        RETURN listener
    END TCPNewListener;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
    PROCEDURE NSGetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
        VAR connection: NetSystem.Stream;
    BEGIN connection := c(NSChannel).connection;
        available := NetSystem.Available(connection);
        terminated := (available = 0) & (connection.C.state = NetSystem.closed)
    END NSGetState;
    PROCEDURE NSReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
    BEGIN NetSystem.ReadBytes(c(NSChannel).connection, bytes, 0, n)
    END NSReadBytes;
    PROCEDURE NSSendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
        VAR connection: NetSystem.Stream;
    BEGIN connection := c(NSChannel).connection;
        IF connection.C.state # NetSystem.closed THEN NetSystem.WriteBytes(connection, bytes, 0, n) END
    END NSSendBytes;
    PROCEDURE NSSendBreak(c: Channel);
    END NSSendBreak;
    PROCEDURE NSClose(c: Channel);
        VAR connection: NetSystem.Stream;
    BEGIN connection := c(NSChannel).connection;
        IF connection.C.state # NetSystem.closed THEN NetSystem.CloseConnection(connection.C) END
    END NSClose;
    PROCEDURE NSSelfChannel(t: Task): Channel;
    BEGIN RETURN t(NSTask).c.channel
    END NSSelfChannel;
    PROCEDURE NSSetupChannel(connection: NSConnection; VAR channel: Channel; VAR task: Task);
        VAR c: NSChannel; t: NSTask;
    BEGIN NEW(c); c.connection := connection; connection.channel := c;
        c.getState := NSGetState; c.readBytes := NSReadBytes;
        c.sendBytes := NSSendBytes; c.sendBreak := NSSendBreak; c.close := NSClose;
        NEW(t); t.c := connection; t.channel := NSSelfChannel;
        channel := c; task := t
    END NSSetupChannel;
    PROCEDURE NSNewSession(hostname: ARRAY OF CHAR; port: LONGINT): Session;
        VAR res: INTEGER; connection: NSConnection; channel: Channel; t: Task; s: Session; c: NetSystem.Connection;
    BEGIN s := NIL;
        NEW(c); NetSystem.OpenConnection(NetSystem.anyport, SHORT(port), hostname, NetSystem.tcp, c, res);
        IF res = NetSystem.done THEN
            NEW(connection); NetSystem.OpenStream(connection, c);
            NSSetupChannel(connection, channel, t); s := NewSession(channel, t, hostname)
        END;
        RETURN s
    END NSNewSession;
    PROCEDURE NSRequested(l: Listener): BOOLEAN;
    BEGIN RETURN NetSystem.Requested(l(NSListener).l)
    END NSRequested;
    PROCEDURE NSAcceptedSession(l: Listener; VAR serverName: ARRAY OF CHAR): Session;
        VAR res: INTEGER; c: NSConnection; channel: Channel; t: Task; s: Session; connection: NetSystem.Connection;
    BEGIN s := NIL;
        NEW(c); NetSystem.Accept(l(NSListener).l, connection, res);
        IF res = NetSystem.done THEN
            NetSystem.OpenStream(c, connection);
            NSSetupChannel(c, channel, t); s := NewSession(channel, t, serverName) END;
        RETURN s
    END NSAcceptedSession;
    PROCEDURE NSRemove(l: Listener);
    BEGIN NetSystem.CloseConnection(l(NSListener).l)
    END NSRemove;
    PROCEDURE NSNewListener(port: LONGINT): NSListener;
        VAR res: INTEGER; listener: NSListener; l: NetSystem.Connection;
    BEGIN listener := NIL;
        NEW(l);
        NetSystem.OpenConnection(SHORT(port), NetSystem.anyport, NetSystem.anyIP, NetSystem.tcp, l, res);
        IF res = NetSystem.done THEN NEW(listener); listener.l := l;
            listener.requested := NSRequested; listener.acceptedSession := NSAcceptedSession;
            listener.remove := NSRemove
        END;
        RETURN listener
    END NSNewListener;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
s := TCPNewSession(hostname, port)
Syntax10.Scn.Fnt
s := NSNewSession(hostname, port)
Syntax10.Scn.Fnt
l := TCPNewListener(port);
                IF l # NIL THEN ok := TRUE; s.listener := l; s.notify := c END
Syntax10.Scn.Fnt
l := NSNewListener(port);
                IF l # NIL THEN ok := TRUE; s.listener := l; s.notify := c END
Syntax10.Scn.Fnt
(*V24*)
MODULE Sessions; (* ww
    IMPORT
(*TCP*)
V24,
(*NetSystem*)
Oberon, Texts, Viewers, Display;
    CONST
        Sec* = 300;
    TYPE
        Channel = POINTER TO ChannelDesc;
        Terminal* = POINTER TO TerminalDesc;
        Session* = POINTER TO SessionDesc;
        SessionDesc = RECORD
            name: ARRAY 64 OF CHAR;
            terminals, p: Terminal;
            nomoreneeded: BOOLEAN;
            channel: Channel
        END;
        ChannelDesc = RECORD
            getState: PROCEDURE (c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
            readBytes: PROCEDURE (c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
            sendBytes: PROCEDURE (c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
            sendBreak: PROCEDURE (c: Channel);
            close: PROCEDURE (c: Channel);
            session: Session
        END;
        Task = POINTER TO TaskDesc;
        TaskDesc = RECORD(Oberon.TaskDesc)
            channel: PROCEDURE (self: Task): Channel
        END;
        Receiver* = PROCEDURE (t: Terminal; ch: CHAR);
        Flusher* = PROCEDURE (t: Terminal; changed, terminated: BOOLEAN);
        TerminalDesc* = RECORD
            next: Terminal;
            session: Session;
            nextTime, timeout*: LONGINT;
            receive*: Receiver;
            flush*: Flusher;
            safe*: BOOLEAN
        END;
        Sentinel = POINTER TO RECORD(TerminalDesc) END;
        Tester* = PROCEDURE (t: Terminal): BOOLEAN;
        IdentifyMsg* = RECORD(Display.FrameMsg) session*: Session END;
        Listener = POINTER TO ListenerDesc;
        Service* = POINTER TO ServiceDesc;
        ServiceCall* = PROCEDURE (this: Service; s: Session);
        ServiceDesc* = RECORD
            name: ARRAY 64 OF CHAR;
            notify: ServiceCall;
            listener: Listener
        END;
        ListenerDesc = RECORD
            requested: PROCEDURE (l: Listener): BOOLEAN;
            acceptedSession: PROCEDURE (l: Listener; VAR serverName: ARRAY OF CHAR): Session;
            remove: PROCEDURE (l: Listener)
        END;
        ServiceTask = POINTER TO RECORD(Oberon.TaskDesc) service: Service END;
(*TCP*)
(*NetSystem*)
        v24Session: Session;
    PROCEDURE Distribute(s: Session; ch: CHAR);
        VAR t: Terminal;
    BEGIN s.p := s.terminals; t := s.p.next;
        WHILE ~(t IS Sentinel) DO
            IF ~t.safe THEN s.p.next := t.next; t.next := NIL END;
            t.receive(t, ch);
            IF (t.session = s) & (t.next = NIL) THEN t.next := s.p.next; s.p.next := t; s.p := t
            ELSIF s.p.next = t THEN s.p := t
            END;
            t := s.p.next
        END
    END Distribute;
    PROCEDURE Flush(s: Session; changed, terminated: BOOLEAN);
        VAR t: Terminal; now: LONGINT;
    BEGIN now := Oberon.Time(); s.p := s.terminals; t := s.p.next;
        WHILE ~(t IS Sentinel) DO
            IF changed OR terminated OR (t.nextTime <= now) & (t.timeout >= 0) THEN
                IF ~t.safe THEN s.p.next := t.next; t.next := NIL END;
                t.flush(t, changed, terminated); t.nextTime := now + t.timeout;
                IF (t.session = s) & (t.next = NIL) THEN t.next := s.p.next; s.p.next := t; s.p := t
                ELSIF s.p.next = t THEN s.p := t
                END
            ELSE s.p := t
            END;
            t := s.p.next
        END
    END Flush;
    PROCEDURE Close*(s: Session);
        VAR c: Channel;
    BEGIN c := s.channel;
        IF c.close # NIL THEN c.close(c) END
    END Close;
    PROCEDURE TaskHandler;
        CONST BufSize = 4096;
        VAR n, i: LONGINT; terminated: BOOLEAN; s: Session; c: Channel; self: Task; buf: ARRAY BufSize OF CHAR;
    BEGIN self := Oberon.CurTask(Task); c := self.channel(self);
        IF c # NIL THEN s := c.session; c.getState(c, n, terminated);
            IF n # 0 THEN
                IF n > BufSize THEN n := BufSize END;
                c.readBytes(c, buf, n);
                i := 0;
                REPEAT Distribute(s, buf[i]); INC(i) UNTIL i = n
            END;
            Flush(s, n # 0, terminated);
            IF terminated THEN Close(s); Oberon.Remove(Oberon.CurTask) END
        ELSE Oberon.Remove(Oberon.CurTask)
        END
    END TaskHandler;
    PROCEDURE NewSession(c: Channel; task: Task; VAR name: ARRAY OF CHAR): Session;
        VAR s: Session; sentinel: Sentinel;
    BEGIN NEW(s); COPY(name, s.name);
        s.channel := c; c.session := s;
        NEW(sentinel); s.terminals := sentinel; sentinel.session := s; sentinel.next := sentinel;
        task.handle := TaskHandler; task.safe := TRUE; task.time := -1;
        Oberon.Install(task);
        RETURN s
    END NewSession;
    PROCEDURE Install*(t: Terminal; s: Session; r: Receiver; f: Flusher; timeout: LONGINT);
        VAR sentinel: Terminal;
    BEGIN ASSERT(t.session = NIL);
        t.session := s; sentinel := s.terminals; t.next := sentinel.next; sentinel.next := t;
        IF s.p = s.terminals THEN s.p := t END;
        t.receive := r; t.flush := f; t.timeout := timeout; t.nextTime := Oberon.Time() + timeout
    END Install;
    PROCEDURE Remove*(t: Terminal);
        VAR p, q: Terminal; s: Session;
    BEGIN s := t.session;
        IF s # NIL THEN p := s.terminals; q := p.next;
            WHILE (q # t) & ~(q IS Sentinel) DO p := q; q := q.next END;
            IF q = t THEN p.next := t.next;
                IF q = s.p THEN s.p := p END
            END;
            t.session := NIL; t.next := NIL;
            p := s.terminals;
            IF p.next = p THEN Close(s) END
        END
    END Remove;
    PROCEDURE ThisSession*(t: Terminal): Session;
    BEGIN RETURN t.session
    END ThisSession;
    PROCEDURE ThisTerminal*(s: Session; test: Tester): Terminal;
        VAR t: Terminal;
    BEGIN t := s.terminals.next;
        WHILE ~(t IS Sentinel) & ~test(t) DO t := t.next END;
        IF t IS Sentinel THEN RETURN NIL ELSE RETURN t END
    END ThisTerminal;
    PROCEDURE GetName*(s: Session; VAR name: ARRAY OF CHAR);
    BEGIN COPY(s.name, name)
    END GetName;
    PROCEDURE SendChar*(s: Session; ch: CHAR);
        VAR c: Channel; buf: ARRAY 1 OF CHAR;
    BEGIN c := s.channel; buf[0] := ch; c.sendBytes(c, buf, 1)
    END SendChar;
    PROCEDURE SendBytes*(s: Session; VAR bytes: ARRAY OF CHAR; n: LONGINT);
        VAR c: Channel;
    BEGIN c := s.channel; c.sendBytes(c, bytes, n)
    END SendBytes;
    PROCEDURE SendString*(s: Session; str: ARRAY OF CHAR);
        VAR i: LONGINT; c: Channel;
    BEGIN i := 0;
        WHILE str[i] # 0X DO INC(i) END;
        c := s.channel; c.sendBytes(c, str, i)
    END SendString;
    PROCEDURE SendBreak*(s: Session);
        VAR c: Channel;
    BEGIN c := s.channel; c.sendBreak(c)
    END SendBreak;
(*TCP*)
    PROCEDURE V24GetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
    BEGIN available := V24.Available(); terminated := FALSE
    END V24GetState;
    PROCEDURE V24ReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
        VAR i: LONGINT;
    BEGIN i := 0;
        WHILE i # n DO V24.Receive(bytes[i]); INC(i) END
    END V24ReadBytes;
    PROCEDURE V24SendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
        VAR i: LONGINT;
    BEGIN i := 0;
        WHILE i # n DO V24.Send(bytes[i]); INC(i) END
    END V24SendBytes;
    PROCEDURE V24SendBreak(c: Channel);
    BEGIN V24.Break
    END V24SendBreak;
    PROCEDURE V24SelfChannel(self: Task): Channel;
    BEGIN RETURN v24Session.channel
    END V24SelfChannel;
    PROCEDURE V24NewSession(): Session;
        VAR c: Channel; task: Task; name: ARRAY 4 OF CHAR;
    BEGIN NEW(c); c.getState := V24GetState; c.readBytes := V24ReadBytes;
        c.sendBytes := V24SendBytes; c.sendBreak := V24SendBreak;
        NEW(task); task.channel := V24SelfChannel;
        name := "V24"; RETURN NewSession(c, task, name)
    END V24NewSession;
(*NetSystem*)
    PROCEDURE New*(hostname: ARRAY OF CHAR; port: LONGINT): Session;
        VAR s: Session;
    BEGIN s := NIL;
        IF hostname = "V24" THEN
s := v24Session
        ELSE
(*TCP*)
(*NetSystem*)
        END;
        RETURN s
    END New;
    PROCEDURE ServiceTaskHandler;
        VAR serv: Service; l: Listener; s: Session;
    BEGIN serv := Oberon.CurTask(ServiceTask).service; l := serv.listener;
        IF l # NIL THEN
            IF l.requested(l) THEN s := l.acceptedSession(l, serv.name);
                IF s # NIL THEN serv.notify(serv, s) END
            END
        ELSE Oberon.Remove(Oberon.CurTask)
        END
    END ServiceTaskHandler;
    PROCEDURE InstallService*(s: Service; port: LONGINT; c: ServiceCall; name: ARRAY OF CHAR; VAR ok: BOOLEAN);
        VAR l: Listener; task: ServiceTask;
    BEGIN ok := FALSE;
        IF s.listener = NIL THEN
            IF name = "V24" THEN
            ELSE
(*TCP*)
(*NetSystem*)
            END
        END;
        IF ok THEN NEW(task); task.handle := ServiceTaskHandler; task.time := -1; task.service := s;
            Oberon.Install(task); COPY(name, s.name)
        END
    END InstallService;
    PROCEDURE RemoveService*(s: Service);
        VAR l: Listener;
    BEGIN l := s.listener; l.remove(l); s.listener := NIL
    END RemoveService;
    PROCEDURE Send*;
        VAR text: Texts.Text; beg, end, time: LONGINT; v: Viewers.Viewer; s: Texts.Scanner; identify: IdentifyMsg;
    BEGIN
        IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN v := Oberon.Par.vwr ELSE v := Oberon.FocusViewer END;
        identify.session := NIL; v.handle(v, identify);
        IF identify.session # NIL THEN
            Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
            IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN Oberon.GetSelection(text, beg, end, time);
                IF time > 0 THEN Texts.OpenScanner(s, text, beg); Texts.Scan(s) END
            END;
            LOOP
                IF (s.class = Texts.Name) & (s.s = "BRK") THEN SendBreak(identify.session)
                ELSIF (s.class = Texts.Name) OR (s.class = Texts.String) THEN SendString(identify.session, s.s)
                ELSIF s.class = Texts.Int THEN SendChar(identify.session, CHR(s.i MOD 256))
                ELSE EXIT
                END;
                Texts.Scan(s)
            END
        END
    END Send;
BEGIN
v24Session := V24NewSession()
END Sessions.